set cent on
SET PROC TO SOSPRO
SET PROC TO ADDREPRO
SET PROC TO BOXPROC
STORE ' ' TO AEANAME,AEAADDR,AEACITY,AEACOUN,AEACURR
STORE .F. TO AEAHEAL,AEADECI
DO START
*REST FROM N:MEMO
DR='N:'
F1='PATIENT'
F11='NAME'
F12='FNAME'
F2='COMPANY'
F21='NMCOMP'
F3='Hl_FEE'
f4='national'
F5='PATJAPAN'
F6='PAT_HL'
F61='HLCORP'
F62='CRPNAM'
F63='pathlnm'
F64='HLDATE'
F8='CITY'

STORE 0 TO PL0,PL1,PL2,PL3,PL4,PL5,pl6,pl7,pl8,pl9,pl10,pl11,pl12,pl13,pl14,PS,REC
STORE .T. TO CONT,OTH
STORE .F. TO OKK,CNF,mgr
STORE SPACE(6) TO KODEPAT
STORE SPACE(16) TO PNAME,PFNAME
SELE 1
SET EXCLU OFF
USE &DR&F1 index &dr&f1
SELE 2
SET EXCLU OFF
USE &DR&F2 INDE &DR&F2,&DR&F21
SELE 3
SET EXCLU OFF
USE &DR&F3
SELE 1
DO WHILE CONT
   SET COLOR TO BG+/B
   CLEA
   DO ADDRESSs
   DO ADDRMODI
   IF OTH
      SET COLOR TO BG+/B
      @ 7,1 CLEA TO 23,78
      DO BOX2 WITH 7,3,"RETRIEVAL BY :","PATIENT'S CODE","PATIENT'S NAME",'GR+','RB','GR+','R',PL0,.F.,.T.
      IF LASTKEY()=27
         RETURN
      ENDIF
      IF PL0=1
         DO BOXE WITH 10,3,"PATIENT'S CODE : ",'KODEPAT','GR+','R','W+','N',6,.T.,.T.
         IF LASTKEY()=27
            LOOP
         ENDIF
         SELE 1
         SET EXCLU OFF
         USE &DR&F1 INDE &DR&F1
         SELE 2
         SET EXCLU OFF
         USE &DR&F2 INDEX &DR&F2
         SELE 1
         SEEK KODEPAT
         IF EOF()
            set colo to bg+/b,w+/n
            @ 10, 1 CLEA TO 23,78
            DO BOXT WITH 16,1,"THIS CODE NUMBER DOES NOT MATCH A REGISTERED PATIENT'S CODE, TYPE ANY KEY !",'GR+','R',.F.,.T.
            loop
         ELSE
            OKK=.T.
         endif
      else
         SET COLO TO BG+/B,W+/N
         @ 10,1 CLEA to 23,78
         DO BOXE WITH 10,2,'SURNAME :','PNAME','BG+','B','W+','N',16,.F.,.F.
         DO BOXE WITH 10,29,'FIRST NAME :','PFNAME','BG+','B','W+','N',16,.F.,.F.
         key1=Pname+PFname
         key2=Pfname+Pname
         DO BOXF WITH 15,25,"Processing, Please wait ...",'GR+','R','GR+*',.T.,.T.
         SET COLOR TO BG+/B
         SELE 1
         SET EXCLU OFF
         USE &DR&F1 INDE &DR&F11, &DR&F12
         sele 2
         set exclu off
         use &dr&f2 index &dr&f2
         sele 1
         SET INDEX TO &DR&F11
         seek key1
         if eof()
            SEEK KEY2
            IF EOF()
               SET INDEX TO &DR&F12
               seek key1
               if eof()
                  SEEK KEY2
                  IF EOF()
                     OKK=.f.
                     do PATR10
                  ELSE
                     rec=RECNO()
                     OKK=.t.
                  ENDIF
               else
                  rec=RECNO()
                  OKK=.t.
               endif
            ELSE
               rec=RECNO()
               OKK=.t.
            ENDIF
         else
            rec=RECNO()
            OKK=.t.
         endif
         if okk
            STORE 0 TO cnt,CR
            GO REC
            do while (Pname=pat_name .and. Pfname=pat_f_name) .or. (Pname=pat_f_name .and. PFname=pat_name)
               cnt=cnt+1
               skip
            enddo
            if cnt>1
               do patr777
            eNDIF
            @ 12,1 CLEA TO 23,78
            go rec
            KODEPAT=PAT_FILCOD
         endif
      endif
   ENDIF
   SET COLOR TO BG+/B
   @ 7,3 CLEA TO 23,78
**   display REC
**   WAIT " "

   DO BOXT WITH 7,3,"PATIENT CODE : "+KODEPAT,'GR+','R',.F.,.T.

   DO WHILE OKK
      DO PMODA
      DO BOX2 WITH 20,38,"DO YOU WANT TO :",'CONFIRM','CANCEL','GR+','R','W+','N',PL1,.T.,.T.
      DO CASE
         CASE LASTKEY()=27
            RETURN
         CASE PL1=1
            OTH=.F.
            CNF=.T.
         CASE PL1=2
            STORE .F. TO CNF,OKK
            STORE .T. TO OTH
      ENDCASE
      DO WHILE CNF
         SET COLO TO BG+/B,W+/N
         @ 10,38 CLEA TO 23,78
*         @ 11,45 SAY "MODIFICATION OF DATAS ABOUT"

         SET COLO TO BG+/B,W+/N
         @ 10,43 TO 23,75 DOUBLE
         DO BOXT WITH 10,44,"MODIFICATION OF DATAS ABOUT",'GR+','R',.F.,.T.
         SET COLO TO BG+/B,W+/N
         @ 13,45 prompt "1. PATIENT'S IDENTITY    "
         @ 15,45 PROMPT "2. CMS STATUS (JAPANESE) "
         @ 17,45 PROMPT "3. MEMBERSHIP TYPE       "
         @ 19,45 prompt "4. PATIENT'S ADDRESS     "
         @ 21,45 prompt "5. PATIENT'S EMPLOYMENT  "
         @ 22,45 prompt "6. WINIS INFO UPDATE     "
         menu to pl2
         DO CASE
            CASE PL2=1
               DO PMOD1
               DO PMODA
            CASE PL2=2
               DO PMOD4
               DO PMODA
            CASE PL2=3
               DO PMOD5
               DO PMODA
            CASE PL2=4
               DO PMOD2
               DO PMODA
            CASE PL2=5
               DO PMOD3
               DO PMODA
            CASE PL2=6
               DO PMOD6
               DO PMODA

            CASE LASTKEY()=27
               CNF=.F.
               OKK=.f.
               OKKK=.T.
               CONT=.F.
               SET COLOR TO BG+/B
               @ 10,1 CLEA TO 23,78
         ENDCASE
      ENDDO
   ENDDO
ENDDO
CLEA
RETURN


